home *** CD-ROM | disk | FTP | other *** search
- unit SampleExport;
-
- interface
-
- uses
- Header;
-
- procedure Main (ExportPtr: T_ExportPtr);
-
- implementation
-
- const
- C_Creator = 'GKON'; { GraphicConverter }
- C_Type = 'SamI';
- C_ID = $98765432;
-
- procedure Main (ExportPtr: T_ExportPtr);
-
- var
- err, dummy: OSErr;
- refNum: Integer;
- bytes, temp: Longint;
-
- begin
- err := FSpDelete(ExportPtr^.destFSSpecRec); { delete old one }
-
- { Create the file specified with FSSpecRec; alway data and resource fork ! }
- err := FSpCreate(ExportPtr^.destFSSpecRec, C_Creator, C_Type, 0);
- if err = noErr then
- begin
- FSpCreateResFile(ExportPtr^.destFSSpecRec, C_Creator, C_Type, 0);
- err := ResError;
- end;
-
- if (err = noErr) then
- begin
- err := FSpOpenDF(ExportPtr^.destFSSpecRec, fsWrPerm, refNum);
-
- if (err = noErr) then
- begin
- { Write file format. }
-
- temp := C_ID;
- bytes := 4;
- err := FSWrite(refNum, bytes, @temp); { ID }
- bytes := 4;
- err := FSWrite(refNum, bytes, @ExportPtr^.srcBitsPerPixel);
- bytes := 4;
- err := FSWrite(refNum, bytes, @ExportPtr^.srcBytesPerLine);
- bytes := 4;
- err := FSWrite(refNum, bytes, @ExportPtr^.srcWidth);
- bytes := 4;
- err := FSWrite(refNum, bytes, @ExportPtr^.srcHeight);
- bytes := 4;
- err := FSWrite(refNum, bytes, @ExportPtr^.srcDataSize);
- bytes := 256 * 3 * 2; { color table }
- err := FSWrite(refNum, bytes, ptr(ExportPtr^.srcColorTablePtr));
- bytes := ExportPtr^.srcDataSize;
- err := FSWrite(refNum, bytes, ExportPtr^.srcDataPtr);
-
- dummy := FSClose(refNum);
- end;
- end;
-
- { Set the success value to 1 if everything was ok }
- if (err = noErr) then
- ExportPtr^.success := 1;
-
- end;
-
- end.